home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / PET / S-Super PET / (s)tz.d64 / SAVE.ASM < prev    next >
Assembly Source File  |  2009-01-18  |  6KB  |  209 lines

  1. opt nolist       ;IO  routines: SAVE
  2.  
  3.         xdef read_it,write_it,identification
  4.         xref address, buffer_2,buffer,offset,filename,names     ;variables
  5.         xref line_number,nb_columns,dist_between_names          ;variables
  6.         xref nb_lines,precision,io_error
  7.         xref calculate_address,get_a_char,answer_same_line      ;routines
  8.         xref set_precision                                      ;routine
  9.         xref openf_,fgetrec_,fputrec_,closef_,copystr_,copy_,length_
  10.  
  11. read_it   ldd #read_command
  12.        jsr open_file
  13.        jsr check_for_error
  14.        if eq                            ;if no IO error
  15.            ldd #nb_lines               ;input of parameters
  16.            std address
  17.            jsr read_from_disk
  18.            jsr set_precision
  19.            ldd #0
  20.            std offset
  21.            clr line_number                ;IO = 0
  22.            loop
  23.               jsr calculate_address
  24.               jsr read_from_disk
  25.               jsr check_for_error
  26.            bne quit_reading             ;if there was an error
  27.               inc line_number
  28.               ldb line_number
  29.               cmpb nb_lines
  30.            until eq
  31.            ldd #names                   ;input of line names
  32.            std address
  33.            clr line_number
  34.            loop
  35.               clra
  36.               ldb dist_between_names    ;maximum length of record
  37.                   pshs d
  38.               ldd address
  39.                   pshs d
  40.               ldd control_block
  41.               jsr fgetrec_              ;length of input record left in B
  42.                   leas 4,s
  43.               ldy address
  44.               clr b,y                   ;add  null byte at end of string
  45.               jsr check_for_error
  46.            bne quit_reading
  47.               inc line_number
  48.               ldb line_number
  49.               cmpb nb_lines
  50.            beq quit_reading
  51.               ldd address
  52.               addb dist_between_names
  53.               adca #0
  54.               std address
  55.            endloop
  56. quit_reading  ldd control_block
  57.            jsr closef_
  58.         endif
  59.         rts
  60.  
  61. read_from_disk ldd #80
  62.            pshs d
  63.         ldd #buffer
  64.            pshs d
  65.         ldd control_block
  66.         jsr fgetrec_
  67.            leas 4,s
  68.            pshs d               ;number of chars read
  69.         ldd address
  70.            pshs d               ;where to copy
  71.         ldd #buffer
  72.         jsr copy_
  73.            leas 4,s
  74.         rts
  75.  
  76. write_it  ldd #$b191            ;'w
  77.         jsr open_file
  78.         jsr check_for_error
  79.         if eq                           ;if no IO error
  80.            ldd #precision
  81.            subd #nb_lines               ;length of parameter record
  82.            std length
  83.            ldd #nb_lines
  84.            jsr write_on_disk
  85.            ldb nb_columns               ;length  of records to be sent
  86.            lda #5                       ;(5 bytes per column) x number of col.
  87.            mul
  88.            std length
  89.            ldd #0
  90.            std offset
  91.            clr line_number
  92.            loop
  93.               jsr calculate_address
  94.               jsr write_on_disk
  95.               jsr check_for_error
  96.            bne quit_writing             ;if there was an IO error
  97.               inc line_number
  98.               ldb line_number
  99.               cmpb nb_lines
  100.            until eq
  101.            ldd #names
  102.            std address
  103.            clr line_number
  104.            loop                         ;line IDs written to file
  105.               ldd address
  106.               jsr length_
  107.                  pshs d
  108.               ldd address
  109.                  pshs d
  110.               ldd control_block
  111.               jsr fputrec_
  112.                  leas  4,s
  113.               jsr check_for_error
  114.            bne quit_writing
  115.               inc line_number
  116.               ldb line_number
  117.               cmpb nb_lines
  118.            beq quit_writing
  119.               ldd address
  120.               addb dist_between_names
  121.               adca #0
  122.               std address
  123.            endloop
  124.         endif
  125. quit_writing  ldd control_block
  126.         jsr closef_
  127.         rts
  128.  
  129. write_on_disk   ldx length
  130.            pshs x
  131.            pshs d               ;address sent through D when called
  132.         ldd control_block
  133.         jsr fputrec_
  134.            leas 4,s
  135.         rts
  136.  
  137. ;routine to OPEN_FILE whose name's address is in D
  138.  
  139. open_file     pshs d               ;open mode: 'r or 'w
  140.            ldd #filename
  141.            jsr openf_
  142.            std control_block
  143.               leas 2,s
  144.            rts
  145.  
  146. identification   ldd #filename_prompt
  147.         ldx #filename
  148.         jsr answer_same_line
  149.         rts
  150.  
  151. ;routine to CHECK_FOR_ERROR in IO operations
  152.  
  153. check_for_error  ldb $6a       ;address of IO status
  154.         if ne                   ;in case of IO error
  155.             ldd #buffer         ;err. message put aside in case disk drive
  156.               pshs d            ;has not detected it
  157.             ldd #$301
  158.             jsr copystr_
  159.                 leas 2,s
  160.  
  161.             ldd #read_command   ;disk drive command channel
  162.                pshs d
  163.             ldd #name
  164.             jsr openf_
  165.                std address
  166.                leas 2,s
  167.  
  168.             ldd #20             ;input of error message
  169.                 pshs d
  170.             ldd #buffer_2
  171.                 pshs d
  172.             ldd address
  173.             jsr fgetrec_
  174.                 leas 4,s
  175.  
  176.             addd #buffer_2      ;null byte at end of string
  177.             tfr d,y
  178.             clr ,y
  179.             ldd address
  180.             jsr closef_
  181.  
  182.             ldb buffer_2
  183.             cmpb #'0            ;start of '00, OK,00,00' string
  184.             if eq               ;if error  does not come from drive
  185.               ldd #buffer       ;   then first message recalled
  186.             else
  187.               ldd #buffer_2     ;otherwise, drive's message displayed
  188.             endif
  189.               pshs d
  190.             clrb                ;any char allowed as an answer
  191.             ldx #notice
  192.             jsr get_a_char
  193.                 leas 2,s
  194.             ldb #1              ;to set error flag
  195.         endif
  196.         stb io_error            ;error flag
  197.         rts
  198. length rmb 2
  199. read_command fcb "r",0
  200. control_block rmb 2
  201. filename_prompt fcc "File title ? "
  202.         fcb 0
  203. notice fcc "There is an IO error: %s%n"
  204.         fcc "Please correct, then press any key "
  205.         fcb 0
  206. name fcc "disk"
  207.         fcb 0
  208.         end
  209.